home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1994 / MacHack 1994.toast / MacHack™94 / Talks & Papers / Timothy Knox / yerk 3.66 / tool+ / TimeManager < prev    next >
Text File  |  1994-06-24  |  3KB  |  99 lines
  1. \ Revised Time manager...used for any system >6.0.3 - assumes register A1
  2. \  contains address of record at proc call
  3. \    5/18/93    rfl    revised for new gestalt of version 3.64
  4. \   8/05/93    rfl    changed init: to setProc:
  5. \   1/25/94    rfl    fixed elapsed:
  6.  
  7. \ Read IMIV for a description of what this might be used for..care must
  8. \ be taken not to move memory, rely on unlocked handles, etc.
  9. \ Remember to remove tasks prior to exiting the application.
  10.  
  11. create Tinstall  ( ptr -- result) popA0 " InsTime"  asmcall pushd0 next,
  12. create Tremove   ( ptr -- result) popA0 " rmvTime"  asmcall pushd0 next,
  13. create Tprime    ( len ptr -- result) popD0 popA0 " primeTime" asmcall pushd0 next,
  14.  
  15.  
  16. :CLASS timeTask <super object
  17.  
  18.     int            microseconds    \ true if delay in microseconds
  19.     var            myProc            \ myProc in relative address, will move on install
  20.     var            tmDelay
  21.  
  22.     var            qlink            \ setup extended record, even though this is revised class
  23.     int            qtype
  24.     var            tmAddr
  25.     var            tmCount
  26.  
  27.   :M setProc: ( 'cfaProc --) >body put: myProc ;M
  28.  
  29.   :M microseconds: ( b --) put: microseconds ;M
  30.  
  31. \ once installed, and then removed, you may reInstall using this method
  32.   :M reInstall: ( --) get: myProc +base put: tmAddr
  33.     clear: qType clear: qLink clear: tmCount
  34.     abs: qlink  Tinstall abort" can't install" ;M
  35.  
  36. \ Use this method as the first thing...It loads up the record with values
  37.   :M install: ( -- ) get: myProc body> initProc reInstall: self ;M
  38.  
  39. \ To remove the task from the queue
  40.   :M remove: ( --) abs: qlink  Tremove abort" can't remove" ;M
  41.  
  42. \ positive value is milliseconds, negative value is microseconds
  43.   :M setDelay: ( n --) get: microseconds IF negate THEN put: tmDelay ;M
  44.  
  45.   :M getDelay: ( -- n) get: tmDelay get: microseconds IF negate THEN ;M
  46.  
  47. \ start the task...it doesn't repeat, but must be restarted for continuous operation
  48.   :M go: abs: qlink get: tmDelay Tprime abort" can't start" ;M
  49.  
  50.   :M start: go: self ;M
  51.  
  52.   :M stop: remove: self ;M
  53.  
  54. \ return time remaining during countdown
  55. \  :M time: ( -- microseconds) get: tmCount 20 * ;M
  56.  
  57. \ return time remaining after task has been stopped or executed
  58.   :M remaining: ( -- microseconds) get: tmCount
  59.         dup 0< IF negate ELSE 1000 * THEN ;M
  60.  
  61. \ return time elapsed after task has been stopped or executed
  62.   :M elapsed: ( -- microsecs )
  63.         get: tmDelay
  64.         get: microseconds not
  65.         IF 1000 *  ELSE negate THEN
  66.         remaining: self - ;M
  67.  
  68.   :M on: ( --b) 'type sysv (gestalt) 0=        \ check if revised TM
  69.         IF $ 603 >=
  70.             IF get: qType $ 8000 and
  71.                 IF true ELSE false THEN
  72.             ELSE ." not supported"
  73.             THEN
  74.         ELSE ." not supported"
  75.         THEN ;M
  76.  
  77.   :M pause: stop: self ;M
  78. \ continue counting after a pause...will count so that timer will run for original delay
  79.   :M resume: remaining: self get: microseconds not
  80.         IF 1000 / THEN setDelay: self reinstall: self go: self ;M
  81.  
  82. ;CLASS
  83.  
  84. \ procedure is to install a TprocWord, set the delay when the TprocWord should execute,
  85. \  and when you want to start timing, say go:
  86. \ When you're completely done, just remove:
  87.  
  88. \ rect suz
  89. \ 100 100 200 200 put: suz
  90. \ 
  91. \ timeTask painter
  92. \ :proc paintit pushPort set: fwind  paint: suz  popPort ;proc
  93. \ 5000 setdelay: painter
  94. \ 
  95. \ 'c paintit init: painter
  96. \ install: painter
  97. \ go: painter
  98.  
  99.